perm filename REVAL[F75,JMC]3 blob
sn#195384 filedate 1976-01-08 generic text, type T, neo UTF8
00100
00200
00300 (DEFPROP ALLFNS
00400 (NIL OEV REV1 REV COUNT SUBB ELEM OEVAL OEVAL2 REVAL2 REVAL1 REVAL PRUP X1 X2 X3 X4 X5)
00500 VALUE)
00600
00700 (DEFPROP OEV
00800 (LAMBDA (U V) ((LAMBDA (M N) (LIST (OEVAL U V) COUNT C2)) (SETQ COUNT 0)(SETQ C2 0)))
00900 EXPR)
01000
01100 (DEFPROP REV1
01200 (LAMBDA (U V) ((LAMBDA (M) (CONS (REVAL1 U V) COUNT)) (SETQ COUNT 0)))
01300 EXPR)
01400
01500 (DEFPROP REV
01600 (LAMBDA (U V) ((LAMBDA (M N) (LIST (REVAL U V) COUNT C2)) (SETQ COUNT 0)(SETQ C2 0)
01700 ))
01800 EXPR)
01900
02000 (DEFPROP COUNT
02100 (NIL . 4)
02200 VALUE)
02300
02400 (DEFPROP SUBB
02500 (LAMBDA (X Y Z) (IF (ATOM Z) (IF (EQ Y Z) X Z) (CONS (SUBB X Y (CAR Z)) (SUBB X Y (CDR Z)))))
02600 EXPR)
02700
02800 (DEFPROP ELEM
02900 (NIL ATOM EQ EQUAL CAR CDR CONS NULL LIST CADR CAAR CDAR CDDR PLUS DIFFERENCE
03000 ADD1 SUB1)
03100 VALUE)
03200
03300 (DEFPROP OEVAL
03400 (LAMBDA(E A)
03500 ((LAMBDA(V)
03600 (COND ((ATOM E) (CDR (ASSOC E A)))
03700 ((EQ (CAR E) (QUOTE QUOTE)) (CADR E))
03800 ((EQ (CAR E) (QUOTE IF)) (COND ((OEVAL (CADR E) A) (OEVAL (CADDR E) A)) (T (OEVAL (CADDDR E) A))))
03900 ((MEMBER (CAR E) ELEM)
04000 (EVAL (CONS (CAR E) (MAPCAR (FUNCTION (LAMBDA (W) (LIST (QUOTE QUOTE) (OEVAL W A)))) (CDR E)))))
04100 (T
04200 (OEVAL2 E A)
04300 )))
04400 (SETQ COUNT (ADD1 COUNT))))
04500 EXPR)
04600
04700 (DEFPROP REVAL1
04800 (LAMBDA(E A)
04900 ((LAMBDA(V)
05000 (COND ((ATOM E) ((LAMBDA (W) (REVAL1 (CAR W) (CADR W))) (CDR (ASSOC E A))))
05100 ((EQ (CAR E) (QUOTE QUOTE)) (CADR E))
05200 ((EQ (CAR E) (QUOTE IF)) (COND ((REVAL1 (CADR E) A) (REVAL1 (CADDR E) A)) (T (REVAL1 (CADDDR E) A))))
05300 ((MEMBER (CAR E) ELEM)
05400 (EVAL (CONS (CAR E) (MAPCAR (FUNCTION (LAMBDA (W) (LIST (QUOTE QUOTE) (REVAL1 W A)))) (CDR E)))))
05500 (T
05600 ((LAMBDA(W)
05700 (REVAL1 (CADDR W) (APPEND (PRUP (CADR W) (MAPCAR (FUNCTION (LAMBDA (Z) (LIST Z A))) (CDR E))) A)))
05800 (GET (CAR E) (QUOTE EXPR))))))
05900 (SETQ COUNT (ADD1 COUNT))))
06000 EXPR)
06100
06200 (DEFPROP REVAL
06300 (LAMBDA(E A)
06400 ((LAMBDA(V)
06500 (COND ((ATOM E)
06600 ((LAMBDA(W)
06700 ((LAMBDA (Z) ((LAMBDA (U) Z) (RPLACD W (LIST (LIST (QUOTE QUOTE) Z) NIL))))
06800 (REVAL (CADR W) (CADDR W))))
06900 (ASSOC E A)))
07000 ((EQ (CAR E) (QUOTE QUOTE)) (CADR E))
07100 ((EQ (CAR E) (QUOTE IF)) (COND ((REVAL (CADR E) A) (REVAL (CADDR E) A)) (T (REVAL (CADDDR E) A))))
07200 ((MEMBER (CAR E) ELEM)
07300 (EVAL (CONS (CAR E) (MAPCAR (FUNCTION (LAMBDA (W) (LIST (QUOTE QUOTE) (REVAL W A)))) (CDR E)))))
07400 (T
07500 (REVAL2 E A)
07600 )))
07700 (SETQ COUNT (ADD1 COUNT))))
07800 EXPR)
07900
08000 (DE REVAL2 (E A) ((LAMBDA (X)
08100 ((LAMBDA(W)
08200 (REVAL (CADDR W) (APPEND (PRUP (CADR W) (MAPCAR (FUNCTION (LAMBDA (Z) (LIST Z A))) (CDR E))) A)))
08300 (GET (CAR E) (QUOTE EXPR)))
08400 )(SETQ C2 (ADD1 C2))))
08500
08600 (DE OEVAL2 (E A) ((LAMBDA (X)
08700 ((LAMBDA(Z)
08800 (OEVAL (CADDR Z) (APPEND (PRUP (CADR Z) (MAPCAR (FUNCTION (LAMBDA (W) (OEVAL W A))) (CDR E))) A)))
08900 (GET (CAR E) (QUOTE EXPR)))
09000 )(SETQ C2 (ADD1 C2))))
09100
09200 (DEFPROP PRUP
09300 (LAMBDA (U V) (COND ((NULL U) NIL) (T (CONS (CONS (CAR U) (CAR V)) (PRUP (CDR U) (CDR V))))))
09400 EXPR)
09500
09600 (DEFPROP X1
09700 (NIL (U (QUOTE (A B)) NIL) (V (QUOTE C) NIL) (W (QUOTE (C . C)) NIL))
09800 VALUE)
09900
10000 (DEFPROP X2
10100 (NIL (U A B) (V . C) (W C . C))
10200 VALUE)
10300
10400 (DEFPROP X3
10500 (NIL SUBB (QUOTE A) (QUOTE X) (QUOTE (((X . X) (X . X)) (X . X) X . X)))
10600 VALUE)